PC Answers 1995 May/PC Answers CD-ROM 7 (Future Publishing) (May 1995).iso/vbits/code/cert/trk3_eg/lab_opts/buffers/ed2.frm

Visual Basic Form | 1994-01-25 | 9.4 KB | 319 lines

VERSION 2.00
Begin Form frmMPBE
   Caption         =   "Multiple Paste Buffer Editor"
   ClientHeight    =   2220
   ClientLeft      =   1200
   ClientTop       =   3285
   ClientWidth     =   6615
   Height          =   2910
   Left            =   1140
   LinkTopic       =   "Form1"
   ScaleHeight     =   2220
   ScaleWidth      =   6615
   Top             =   2655
   Width           =   6735
   Begin CommonDialog CMDialog1
      Left            =   3480
      Top             =   1560
   End
   Begin TextBox Text1
      Height          =   1095
      Index           =   1
      Left            =   3120
      MultiLine       =   -1  'True
      TabIndex        =   1
      Top             =   240
      Width           =   3255
   End
   Begin TextBox txtEditBox
      Height          =   1575
      Left            =   0
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   0
      Top             =   0
      Width           =   2895
   End
   Begin Label Label1
      Caption         =   "Paste Buffer #1"
      Height          =   260
      Index           =   1
      Left            =   3120
      TabIndex        =   2
      Top             =   0
      Width           =   1455
   End
   Begin Menu mnuFile
      Caption         =   "&File"
      Begin Menu mnuFileNew
         Caption         =   "&New"
      End
      Begin Menu mnuFileOpen
         Caption         =   "&Open..."
      End
      Begin Menu mnuFileSave
         Caption         =   "&Save"
      End
      Begin Menu mnuFileSaveExit
         Caption         =   "Save &and Exit"
      End
      Begin Menu mnuFileExit
         Caption         =   "E&xit"
      End
   End
   Begin Menu mnuEdit
      Caption         =   "&Edit"
      Begin Menu mnuEditCopy1
         Caption         =   "Copy to Buffer #1"
      End
      Begin Menu mnuEditCopy2
         Caption         =   "Copy to Buffer #2"
      End
      Begin Menu mnuEditCopy3
         Caption         =   "Copy to Buffer #3"
      End
      Begin Menu mnuEditCopy4
         Caption         =   "Copy to Buffer #4"
      End
      Begin Menu mnuEditPaste1
         Caption         =   "Paste from Buffer #1"
      End
      Begin Menu mnuEditPaste2
         Caption         =   "Paste from Buffer #2"
      End
      Begin Menu mnuEditPaste3
         Caption         =   "Paste from Buffer #3"
      End
      Begin Menu mnuEditPaste4
         Caption         =   "Paste from Buffer #4"
      End
   End
   Begin Menu mnuBuffer
      Caption         =   "&Buffers"
      Begin Menu mnuBufferAdd
         Caption         =   "Add"
      End
      Begin Menu mnuBufferRemove
         Caption         =   "Remove"
      End
   End
Option Explicit
Const MAX_BUFFERS = 4
'pastecount is the number of local paste buffers
'It is 1-based.
Dim pastecount As Integer
'lcv (loop control variable) is used in many places
'to drive a for/next loop
Dim lcv As Integer
'dirtyflag is set to value whenever txtEditBox changes
Dim dirtyflag As Integer
'fhandle and fname are used to open (and close) the file.
Dim fhandle As Integer
Dim fname As String
Const TXT_WIDTH = .6
Const SCROLL_BAR_HEIGHT = 675
Const FormTitle = "Multiple Paste Buffer Editor v2.0"
Sub Form_Load ()
    Dim Buffers As Integer
    Dim counter As Integer
    Caption = FormTitle + " (untitled)"
    'Size Form
    frmMPBE.Left = 0
    frmMPBE.Top = 0
    frmMPBE.Width = Screen.Width
    frmMPBE.Height = Screen.Height
    'Set up the common dialog box.
    CMDialog1.Filter = "Text Files (*.txt)|*.txt|All files (*.*)|*.*"
    pastecount = 1
    positionbuffers   'Positions the buffers and resizes the buffers
End Sub
Sub Form_QueryUnload (Cancel As Integer, UnloadMode As Integer)
    Dim rc As Integer
    Const YES = 6
    If dirtyflag Then
        rc = MsgBox("Save changes before terminating?", 4, "File has changed!")
        If rc = YES Then
            mnuFileSave_Click
        End If
    End If
End Sub
Sub Form_Resize ()
    Dim counter As Integer
    txtEditBox.Width = frmMPBE.Width * TXT_WIDTH
    If frmMPBE.Height - SCROLL_BAR_HEIGHT > 0 Then
        txtEditBox.Height = frmMPBE.Height - SCROLL_BAR_HEIGHT
    End If
    For counter = 1 To pastecount
        label1(counter).Left = frmMPBE.Width * TXT_WIDTH + 150
        text1(counter).Left = frmMPBE.Width * TXT_WIDTH + 150
    Next counter
End Sub
Sub mnuBuffer_Click ()
    If pastecount >= MAX_BUFFERS Then
        mnuBufferAdd.Enabled = False
    Else
        mnuBufferAdd.Enabled = True
    End If
    If pastecount = 1 Then
        mnuBufferRemove.Enabled = False
    Else
        mnuBufferRemove.Enabled = True
    End If
End Sub
Sub mnuBufferAdd_Click ()
    Const DELTA = 1500
    pastecount = pastecount + 1
    Load label1(pastecount)
    'label1(pastecount).Top = label1(pastecount - 1).Top + DELTA
    label1(pastecount).Caption = "Paste Buffer #" + LTrim$(Str$(pastecount))
    label1(pastecount).Visible = True
    Load text1(pastecount)
    'text1(pastecount).Top = text1(pastecount - 1).Top + DELTA
    text1(pastecount).Visible = True
    text1(pastecount).Text = ""
    positionbuffers   'Positions the buffers and resizes the buffers
End Sub
Sub mnuBufferRemove_Click ()
    'Unload the label and the text control
    Unload label1(pastecount)
    Unload text1(pastecount)
    pastecount = pastecount - 1
    positionbuffers   'Positions the buffers and resizes the buffers
End Sub
Sub mnuEditCopy1_Click ()
    my_Copy 1
End Sub
Sub mnuEditCopy2_Click ()
    my_Copy 2
End Sub
Sub mnuEditCopy3_Click ()
    my_Copy 3
End Sub
Sub mnuEditCopy4_Click ()
    my_Copy 4
End Sub
Sub mnuEditPaste1_Click ()
    my_Paste 1
End Sub
Sub mnuEditPaste2_Click ()
    my_Paste 2
End Sub
Sub mnuEditPaste3_Click ()
    my_Paste 3
End Sub
Sub mnuEditPaste4_Click ()
    my_Paste 4
End Sub
Sub mnuFileExit_Click ()
    Dim rc As Integer
    Const YES = 6
    If dirtyflag Then
        rc = MsgBox("Save changes before terminating?", 4, "File has changed!")
        If rc = YES Then
            mnuFileSave_Click
        End If
    End If
    'Terminate
    End
End Sub
Sub mnuFileNew_Click ()
    Const YES = 6
    Dim rc As Integer
    If dirtyflag = True Then
        rc = MsgBox("Save changes before a fresh start?", 4, "Text has changed!")
        If rc = YES Then
            mnuFileSave_Click
        End If
    End If
    fname = ""
    txtEditBox.Text = ""
    dirtyflag = False
    frmMPBE.Caption = FormTitle + " (untitled)"
End Sub
Sub mnuFileOpen_Click ()
    Const YES = 6
    Dim rc As Integer
    If dirtyflag = True Then
        rc = MsgBox("Save changes before opening a new file?", 4, "Text has changed!")
        If rc = YES Then
            mnuFileSave_Click
        End If
    End If
    'Invoke the Dialog Box
    CMDialog1.Action = 1
    'If fname is empty, then exit the subroutine.
    fname = CMDialog1.Filename
    If fname = "" Then
        Beep
        Exit Sub
    End If
    'Build the title without a path.
    frmMPBE.Caption = FormTitle + " (" + CMDialog1.Filetitle + ")"
    'Get a fresh handle and read the file in.
    fhandle = FreeFile
    Open fname For Input As fhandle
    txtEditBox.Text = Input$(LOF(fhandle), fhandle)
    dirtyflag = False
    Close fhandle
End Sub
Sub mnuFileSave_Click ()
    If dirtyflag = False Then
        Exit Sub
    End If
    'Get a fresh handle and write the file to it.
    If fname = "" Then
        fname = InputBox$("Enter a file name. File will be saved in " + CurDir$, "No file name available!")
        frmMPBE.Caption = FormTitle + " (" + fname + ")"
    End If
    'Now if fname is empty, terminate the subroutine.
    If fname = "" Then
        Exit Sub
    End If
    fhandle = FreeFile
    Open fname For Output As fhandle
    Print #fhandle, txtEditBox.Text
    Close fhandle
    dirtyflag = False
End Sub
Sub mnuFileSaveExit_Click ()
    mnuFileSave_Click
    End
End Sub
Sub my_Copy (index As Integer)
    If index > pastecount Then
        Beep
        MsgBox "Buffer isn't available.", 0, "Too high!"
        Exit Sub
    End If
    If Not Screen.ActiveControl Is txtEditBox Then
        MsgBox "You must have something selected in the editing window.", 0, "Nothing Selected!"
        Exit Sub
    End If
    text1(index).Text = txtEditBox.SelText
End Sub
Sub my_Paste (index As Integer)
    If index > pastecount Then
        Beep
        MsgBox "Buffer isn't available.", 0, "Too high!"
        Exit Sub
    End If
    If Not Screen.ActiveControl Is txtEditBox Then
        MsgBox "You must place the cursor in the editing window.", 0, "Not in Editing Window!"
        Exit Sub
    End If
    txtEditBox.SelText = text1(index).Text
End Sub
Sub positionbuffers ()
    Dim cnt As Integer
    Dim frmheight As Integer
    frmheight = frmMPBE.ScaleHeight - 60
    For cnt = 1 To pastecount
        text1(cnt).Height = frmheight / pastecount - 250
        text1(cnt).Top = (cnt - 1) * frmheight / pastecount + 250
        label1(cnt).Top = (cnt - 1) * frmheight / pastecount + 20
    Next
End Sub
Sub txtEditBox_Change ()
    dirtyflag = True
End Sub